perm filename PATTER.LSP[E80,JMC]1 blob
sn#525106 filedate 1980-07-23 generic text, type C, neo UTF8
COMMENT ā VALID 00002 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00002 00002 inst using throw and catch
C00004 ENDMK
Cā;
;;;inst using throw and catch
(DEFUN ISVAR (X) (MEMBER X '(X X0 X1 X2 Y Y0 Y1 Y2 Z Z0 Z1 Z2 U U0 U1 U2
V V0 V1 V2 W W0 W1 W2)))
(defun inst (pat exp a) (catch (inst1 pat exp a)))
(defun inst1 (pat exp a) (if (isvar pat) ((lambda (w)
(if (null w) (cons (cons pat exp) a) (equal (cdr w) exp) a (throw 'no))
) (assoc pat a))
(atom pat) (if (eq pat exp) a (throw 'no))
(atom exp) (throw 'no)
(inst1 (cdr pat) (cdr exp) (inst1 (car pat) (car exp) a))))
;;;inst using predicates
(defun instp (pat exp a) (if (isvar pat) ((lambda (w)
(or (and (null w) (cons (cons pat exp) a))
(and (eq (cdr w) exp) a))) (assoc pat a))
(atom pat) (and (eq pat exp) a)
(and (not (atom exp)) (instp (cdr pat) (cdr exp) (instp (car pat) (car exp) a)))
))